Aminet 4/Aminet 4 - November 1994.iso/aminet/comm/misc/mirrorman_1_10b1.lha/MirrorManager-1.10b1/rexx/CleanupIncoming.mm

Text File | 1994-06-24 | 21KB | 644 lines

/*rx
    $VER: $Id: CleanupIncoming.mm,v 1.9 1994/06/20 01:08:16 tf Exp $

    This script examines (non-recursively) the files in your INCOMING
    directory and looks them up in an Aminet mirror INDEX file.
    For each file in your INCOMING directory which is listed exactly
    *once* in the aminet index file the following actions can be
    performed:

    o  A filenote (comment) can be added according to the one listed
       in your Aminet index file and

    o  The file can be copied (or moved) to the location listed
       in the aminet index.

    (The Aminet directory hierarchy can be created using 'MakeTree.rexx')

    This ARexx script needs the AmigaDOS commands "List", "Sort",
    "Search", "Filenote", "Copy" and "Delete" available in your path.

    Initial revision by Tobias Ferber, 22-Feb-94
*/

options results
options failat 10

call pragma('S',102400)

/* initialize globals */

frompath   = ""  /* incoming directory */
topath     = ""  /* path to the Aminet mirror */
indexpath  = ""  /* Aminet index file or FAST index path */
mapfile    = ""  /* remap tree file */

fastprefix = "FAST."
tempfile   = "T:CleanupIncomingTemp." || pragma('Id')
tempinfo   = "T:CleanupIncomingTempInfo." || pragma('Id')
template   = "FROM/K/A,TO/K,WITH=INDEX/K/A,MOVE/S,COPY/S,NOCOMMENT/S,MAKEPATH/S,REPLACE/S,FAST/S,REMAP/K,LONG/S,AUTO/S"
args       = ""
cliopts    = ""

dg       = 0  /* gauge increment */
gstepN   = 0

ESC      = '1b'x

signal on HALT
signal on BREAK_C
signal on BREAK_D


/* parse args */

do ac=1 while ac <= arg()
  av= arg(ac)
  select
    when upper(av) = "FROM" then do
      if ac < arg() then do
        ac= ac+1
        frompath= arg(ac)
        if words(frompath) < 1 then frompath= pragma('D')
        end
      else exit bad_args('Missing pathname after' ESC'bFROM'ESC'n keyword.')
      end /* FROM */

    when upper(av) = "TO" then do
      if ac < arg() then do
        ac= ac+1
        topath= arg(ac)
        if words(topath) < 1 then topath= pragma('D')
        end
      else exit bad_args('Missing pathname after' ESC'bTO'ESC'n keyword.')
      end /* TO */

    when (upper(av) = "INDEX") | (upper(av) = "WITH") then do
      if ac < arg() then do
        ac= ac+1
        indexpath= arg(ac)
        end
      else exit bad_args('Missing index pathname after' ESC'b'upper(av)ESC'n keyword.')
      end /* INDEX,WITH */

    when upper(av) = "REMAP" then do
      if ac < arg() then do
        ac= ac+1
        mapfile= arg(ac)
        end
      else exit bad_args('Missing remap filename after' ESC'bREMAP'ESC'n keyword.')
      end /* INDEX,WITH */

    when upper(av) = "COPY" then do
      if (lastpos('d',cliopts) < 1) then cliopts = cliopts || 'c'
      else exit bad_args('Only one of' ESC'bCOPY'ESC'n or' ESC'bMOVE'ESC'n is allowed.')
      end /* COPY */

    when upper(av) = "MOVE" then do
      if (lastpos('c',cliopts) < 1) then cliopts = cliopts || 'cd'
      else exit bad_args('Only one of' ESC'bCOPY'ESC'n or' ESC'bMOVE'ESC'n is allowed.')
      end /* MOVE */

    when upper(av) = "NOCOMMENT" then cliopts = cliopts || 'n'
    when upper(av) = "MAKEPATH"  then cliopts = cliopts || 'm'
    when upper(av) = "REPLACE"   then cliopts = cliopts || 'r'
    when upper(av) = "FAST"      then cliopts = cliopts || 'f'
    when upper(av) = "LONG"      then cliopts = cliopts || 'l'
    when upper(av) = "AUTO"      then cliopts = cliopts || 'a'

    otherwise exit bad_args('Unknown keyword:' ESC'b' || av || ESC'n')

  end /* select */

end /* do */

call pragma('W','N')


if (words(mapfile) > 0) & ~exists(mapfile) then do
  REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                BODY    '"CleanupIncoming failed to locate your remap file*n*n' ||,
                        ESC'c'ESC'b' || mapfile || ESC'n'ESC'l'                 || '"',
                GADGETS '"Exit"'
  exit 10
  end


/* try to get missing index path or file */

if words(indexpath) < 1 then do
  cwd= strip(pragma('D'),'B','"')
  if pos('f',cliopts) > 0 then REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select fast index path..."' DRAWERSONLY NOICONS
                          else REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select an index file..."' NOICONS
  if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then indexpath= result
  end

if words(indexpath) < 1 then
  exit bad_args("Not enough arguments for CleanupIncoming...  Exiting...")

if ~exists(indexpath) then do
  REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                BODY    '"CleanupIncoming failed to locate your index path*n*n' ||,
                        ESC'c'ESC'b' || indexpath || ESC'n'ESC'l'               || '"',
                GADGETS '"Exit"'
  exit 10
  end


/* try to get missing from path */

if words(frompath) < 1 then do
  cwd= strip(pragma('D'),'B','"')
  REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select the source directory..."' DRAWERSONLY NOICONS
  if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then frompath= result
  end

if words(frompath) < 1 then
  exit bad_args("Not enough arguments for CleanupIncoming...  Exiting...")

if ~exists(frompath) then do
  REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                BODY    '"CleanupIncoming failed to locate your source directory*n*n' ||,
                        ESC'c'ESC'b' || frompath || ESC'n'ESC'l'                      || '"',
                GADGETS '"Exit"'
  exit 10
  end


/* eventually try to get missing destination path */

if (pos('c',cliopts) > 0) then do
  if words(topath) < 1 then do
    cwd= strip(pragma('D'),'B','"')
    REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select the destination direcory..."' DRAWERSONLY NOICONS SAVEMODE
    if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then topath= result
    end

  if words(topath) < 1 then
    exit bad_args("Not enough arguments for CleanupIncoming...*nExiting...")

  if ~exists(topath) & canexist(topath) then do
    if pos('m',cliopts) > 0 then call makepath(topath)
    else do
      REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                    BODY    '"Destination path*n*n'                      ||,
                            ESC'c'ESC'b' || topath || ESC'n'ESC'l*n*n'   ||,
                            'does not exist.  Shall I create it?'        || '"',
                    GADGETS '"_Yes|_All|_No"'
      if result > 0 then do
        if result > 1 then cliopts = cliopts || 'm'
        call makepath(topath)
        end
      else do
        REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                      BODY    '"Operation canceled."',
                      GADGETS '"Exit"'
        exit
        end
      end
    if exists(topath) then MESSAGE '"'topath'   [created]"'
    end

  if ~exists(topath) then do
    REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                  BODY    '"CleanupIncoming failed to create your destination path*n*n' ||,
                          ESC'c'ESC'b' || topath || ESC'n'ESC'l'                        || '"',
                  GADGETS '"Exit"'
    exit 10
    end
  end

signal on ERROR
signal on IOERR

signal on FAILURE
/*signal on NOVALUE*/
signal on SYNTAX


/* do the hard part */

MESSAGE CLEAR; MESSAGE OPEN; WORKING '"Collecting files... Please wait..."'
address command 'List FILES DIR "' || frompath || '" LFORMAT "%n" TO "' || tempfile || '"'

CALL init_gauge(tempfile,2)

/* eventually sort the tempfile (speeds up FAST option for disk cache tools) */

lib= show('L',"rexxsupport.library")
if ~lib then lib= addlib("rexxsupport.library",0,-30,0)

if lib then do
  if value( word(statef(tempfile),2) ) > 0 then
    address command 'Sort FROM "' || tempfile || '" TO "' || tempfile || '"'
  call remlib("rexxsupport.library")
  end
else say 'Warning: rexxsupport.library not available; processing file list unsorted ...'

if ~open('fp',tempfile,'R') then do
  REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                BODY    '"Could not open temporary file*n*n'     ||,
                        ESC'c'ESC'b' || tempfile || ESC'n'ESC'l' || '"',
                GADGETS '"Exit"'
  exit 10
  end

do until eof('fp')

  fname= strip( readln('fp') )
  if (words(fname) > 0) & (pos('|',fname) < 1) then do

    if pos('f',cliopts) > 0 then indexfile = tackon(indexpath,fastprefix) || upper(left(fname,1))
                            else indexfile = indexpath

    if exists(indexfile) then do
      MESSAGE transquote('Searching for "'fname'" in' indexfile '...')

      signal off ERROR
      address command searchcmd(fname,indexfile)
      signal on ERROR

      if ~open('ifp',tempinfo,'R') then do
        REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                      BODY    '"Search failed.  Could not open*n*n'    ||,
                              ESC'c'ESC'b' || tempinfo || ESC'n'ESC'l' || '"',
                      GADGETS '"Exit"'
        call close('fp')
        exit 10
        end

      fnote = ""
      fdir = ""
      matches = 0

      CALL step_gauge(1)

      do until eof('ifp') | matches > 1
        istr= strip( readln('ifp') )

        if words(istr) > 0 then do
          if pos('l',cliopts) > 0 then parse var istr f d . . 42 c  /* LONG index file */
                                  else parse var istr f d .   38 c

          if f = fname then do
            if matches = 0 then do
              fnote = c
              fdir  = d
              matches= matches + 1
              end
            else if (fnote ~= c) | (fdir ~= d) then matches= matches + 1
            end
          end

          /* else we matched the comment */

        end /* scan ifp */

      call close('ifp')

      fromfile = tackon(frompath,fname)

      if exists(fromfile) then do   /* Maybe someone deleted our fromfile meanwhile... */

        select /* #of matches */

          when matches = 1 then do

            if pos('n',cliopts) < 1 then do
              fnote= transquote(fnote)
              MESSAGE transquote('Adding filenote' fnote 'to' '"'fromfile'"')
              address command 'Filenote QUIET FILE' fromfile 'COMMENT' fnote
              end

            if pos('c',cliopts) > 0 then do

              if words(mapfile) > 0 then do
                MESSAGE transquote('Searching for' fdir 'in' mapfile '...')

                signal off ERROR
                address command searchcmd(fdir,mapfile)
                signal on ERROR

                if ~open('ifp',tempinfo,'R') then do
                  REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                                BODY    '"Search failed.  Could not open*n*n'    ||,
                                        ESC'c'ESC'b' || tempinfo || ESC'n'ESC'l' || '"',
                                GADGETS '"Exit"'
                  call close('fp')
                  exit 10
                  end

                mappings= 0
                do until eof('ifp') | (mappings > 1)
                  istr= strip( readln('ifp') )
                  if (words(istr) > 0) & (left(istr,1) ~= '#') then do
                    parse var istr src dst
                    dst= strip(dst)

                    if (upper(src) = upper(fdir)) then do
                      if words(dst) < 1 then dst= src
                      mappings= mappings + 1
                      end

                    end
                  end /* do */

                call close('ifp')

                if mappings = 1 then do
                  if pos(':',dst) > 0 then destpath= dst
                                      else destpath= tackon(topath,dst)
                  end

                end

              else do /* no mapfile */
                if fdir ~= "." then destpath= tackon(topath,fdir)
                               else destpath= topath
                mappings= 1  /* not remapped */
                end


              select /* #of mappings */

                when mappings = 1 then do   /* or if not remapped */

                  if ~exists(destpath) & canexist(destpath) then do
                    if pos('m',cliopts) > 0 then call makepath(destpath)
                    else do
                      REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                                    BODY    '"Destination path*n*n'                      ||,
                                            ESC'c'ESC'b' || destpath || ESC'n'ESC'l*n*n' ||,
                                            'does not exist.  Shall I create it?'        || '"',
                                    GADGETS '"_Yes|_All|_No"'
                      if result > 0 then do
                        if result > 1 then cliopts = cliopts || 'm'
                        call makepath(destpath)
                        end
                      end
                    if exists(destpath) then MESSAGE '"'destpath'   [created]"'
                    end

                  if exists(destpath) then do
                    tofile= tackon(destpath,fname)
                    MESSAGE transquote('Copying "'fromfile'" to "'tofile'" ...')
                    if exists(tofile) then do
                      if pos('r',cliopts) > 0 then address command 'Copy QUIET CLONE FROM "'fromfile'" TO "'tofile'"'
                      else do
                        REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                                      BODY    '"'ESC'c'ESC'b' || tofile || ESC'n'ESC'l*n*n' ||,
                                              'already exists.  Shall I replace it?'        || '"',
                                      GADGETS '"_Yes|_All|_No"'
                        if result > 0 then do
                          if result > 1 then cliopts = cliopts || 'r'
                          address command 'Copy QUIET CLONE FROM "'fromfile'" TO "'tofile'"'
                          end
                        else MESSAGE transquote(tofile 'not replaced')
                        end
                      end
                    else address command 'Copy QUIET CLONE FROM "'fromfile'" TO "'tofile'"'

                    if (pos('d',cliopts) > 0) & exists(tofile) then do
                      MESSAGE transquote('Removing "'fname'" from' frompath)
                      address command 'Delete QUIET FILE "'fromfile'"'
                      end
                    end
                  else MESSAGE transquote('Warning: "'fname'" ignored.  (Destination path "'destpath'" not created)')
                  end

                when mappings < 1 then do
                  MESSAGE transquote('Warning: path' fdir 'has not been remapped in' mapfile '...' fname 'skipped')
                  end

                otherwise do /* mappings > 1 */
                  MESSAGE transquote('Warning: path' fdir 'has been remapped more than once in' mapfile '...' fname 'skipped')
                  end

                end /* select #of mappings */

              end /* pos('c',cliopts) > 0 */

            end /* matches = 1 */

          when matches = 0 then do
            MESSAGE transquote('Warning: file "'fname'" not found in index file "'indexfile'"')
            end

          otherwise do
            MESSAGE transquote('Warning: filename "'fname'" is ambiguous ... skipped')
            end

          end /* select */

        end /* exists(fromfile) */

      else MESSAGE transquote('Warning: "'fromfile'" does not exist anymore ... ignored')
      address command 'Delete QUIET FILE "' || tempinfo || '"'

      end /* exists(indexfile) */

    else MESSAGE transquote('Index file "'indexfile'" does not exist ...  "'fname'" skipped')

    end /* have fname */

  CALL step_gauge(1)

  end /* do scan fp */

call close('fp')
MESSAGE '"Deleting temporary file list' tempfile '..."'
address command 'Delete QUIET FILE "' || tempfile || '"'
COMPLETE 100
MESSAGE '"done."'
IF POS('a',cliopts) > 0 THEN MESSAGE CLOSE;
exit 0

/**/

bad_args: PROCEDURE EXPOSE template ESC
  PARSE ARG msg

  REQUESTCHOICE TITLE   '"CleanupIncoming Request"',
                BODY    '"' || msg || '*n*n'                     ||,
                        'CleanupIncoming args template:*n*n'     ||,
                        ESC'c'ESC'b' || template || ESC'n'ESC'l' || '"',
                GADGETS '"Okay"'
  RETURN 0


/* generate the search command string */

searchcmd: PROCEDURE EXPOSE tempinfo
  PARSE ARG pattern,file
  return 'Search NONUM > "'tempinfo'" FROM "'file'" SEARCH "'pattern'"'
  /*return 'AGrep > "'tempinfo'"' '"'pattern'"' '"'file'"'*/

/*@*/


/* translate '"' into '*"' and '*' into '**' */

transquote: procedure
  parse arg s
  t= s
  q= max( lastpos('*',s), lastpos('"',s) )
  do while q > 0
    t= insert('*',t,q-1,1)
    s= left(s,q-1)
    q= max( lastpos('*',s), lastpos('"',s) )
    end
  return '"' || t || '"'


/* return the non-file part of a pathname */

pathonly: procedure
  parse arg path
  if (words(path) > 0) & (right(path,1) ~= ':') then do
    if right(path,1) = '/' then path= left(path,length(path)-1)
    if lastpos('/',path) > lastpos(':',path) then path= left(path,lastpos('/',path)-1)
                                             else path= left(path,lastpos(':',path))
    end
  return path


/* return the file part of a pathname */

fileonly: procedure
  parse arg path
  if right(path,1) = '/' then path= left(path,length(path)-1)
  p= max( lastpos(':',path), lastpos('/',path) )
  if(p>0) then return substr(path,p+1)
          else return path


/* concatenate the filename to the pathname and return the resulting string */

tackon: procedure
  parse arg path,file
  do while left(file,1) = '/'
    file= substr(file,2)
    path= pathonly(path)
    end
  if (words(path) > 0) & (right(path,1) ~= '/') & (right(path,1) ~= ':') then path= path || '/'
  if (right(file,1) = '/') then file= left(file,length(file)-1)
  return path || file


/* create all non-existant directories in a path */

makepath: procedure
  parse arg path
  if right(path,1) = '/' then path= left(path,length(path)-1)
  if ~exists(path) then do
    call makepath( pathonly(path) )
    address command 'MakeDir NAME "'path'"'
    end
  return 0


/*
 * return   1  if the device or volume name in given pathname exists
 *             or if no device or volume was present (current device)
 *          0  if the device or volume name does not exist
 */

canexist: procedure
  parse upper arg path
  if pos(':',path) < 1 then return 1 /* current device */
  call pragma('W','N')
  return exists( left(path,lastpos(':',path)) )


/* stretch the blue completion bar */

step_gauge: PROCEDURE EXPOSE dg gstepN
  ARG increment
  gstepN= gstepN + 1
  c= MIN(TRUNC(gstepN * increment * dg),100)
  COMPLETE c
  IF c >= 100 THEN WORKING '"done."'
  RETURN 0


/* initialize the gauge increment by counting the #of steps to be performed */

init_gauge: PROCEDURE EXPOSE dg gstepN
  PARSE ARG fname,steps_per_entry

  dg = 0         /* gauge increment */
  gstepN = 0     /* #of performed steps */

  IF OPEN('fp',fname,'R') THEN DO
    numentries= 0
    DO UNTIL EOF('fp')
      IF WORDS(READLN('fp')) > 0 THEN
        numentries= numentries+1
      END
    WORKING '"Processing' numentries 'entries..."'
    IF (numentries * steps_per_entry) ~= 0 then dg= 100 / (numentries * steps_per_entry)
                                           else dg= 100
    CALL SEEK('fp',0,'B')
    CALL CLOSE('fp')
    END

  MESSAGE CLEAR; MESSAGE OPEN;
  COMPLETE 0
  RETURN 0


/* error/break handling */

IOERR:
ERROR:
  err= rc
  ESC = '1b'x

  signal off ERROR
  signal off IOERR

  WORKING '"I/O problem trapped... Execution halted."'
  MESSAGE '"I/O problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"CleanupIncoming Error Trap' err'"',
                BODY    '"There was a problem with external I/O in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                || '"',
                GADGETS '"I''ll better exit"'
  exit


FAILURE:
NOVALUE:
SYNTAX:
  err= rc
  ESC = '1b'x

  signal off FAILURE
  signal off NOVALUE
  signal off SYNTAX

  WORKING '"Internal problem trapped... Execution halted."'
  MESSAGE '"Internal problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"CleanupIncoming Internal Error' err'"',
                BODY    '"CleanupIncoming seems to have an internal problem in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                            || '"',
                GADGETS '"I''ll better exit"'
  exit


HALT:
BREAK_C:
BREAK_D:
  signal off HALT
  signal off BREAK_C
  signal off BREAK_D

  WORKING '"Break signal trapped... Execution halted."'
  MESSAGE '"Break signal trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"CleanupIncoming Break Trap"',
                BODY    '"Script execution halted."',
                GADGETS '"Stop"'
  exit